home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / adikit.arc / DSTEST.LSP < prev    next >
Lisp/Scheme  |  1986-12-01  |  5KB  |  161 lines
  1.  
  2.  
  3. (defun wait (s)
  4. ; waits s milleseconds
  5.        (command "delay" (setq z s))
  6. )
  7. (defun graphwait ()
  8. ; goes to graphics screen and waits 1/4 second
  9.        (graphscr)
  10.        (wait 250)
  11. )
  12. (defun starttest (s)
  13. ; tell the user something, and wait for his RETURN. 
  14. ; i.e., print the statement s, tell them to Hit RETURN when ready
  15. ;  then go to graphics and wait 1/4 second
  16. ;
  17. ;  !!!! save the starting prompt in the test file?
  18. ;  !!!! number the tests for restart purposes
  19. ;  
  20.        (if (= "N" comnd) (textscr))
  21.        (print s)
  22.        (print "Hit RETURN when ready to proceed")
  23.        (getstring T)
  24.        (graphwait)
  25.        (repeat 3 (print "  "))
  26. )
  27. (defun getrslt (q)
  28. ; wait a little for the user to look at the result...then
  29. ; ask the user question q and do something with his answer
  30. ; always ask from the text screen...so we don't have problems with
  31. ; command prompt area off or dual screens with only one line cmmnd prompts
  32. ; 
  33. ; also save the result in the test result file
  34. ; and only accept Y y or N n   ask again if not
  35. ; 
  36. ;       
  37.        (wait wtime)
  38.        (if (= comnd "N")
  39.            (command "textscr"))
  40.        (setq z " ")
  41.        (while (and (/= z "Y") (/= z "N"))
  42.           (terpri)
  43.           (setq z (strcase (getstring q)))
  44.        )
  45.        (if (null testf) (terpri)
  46.          (progn
  47.          (write-line q testf)
  48.          (if (= "Y" z)
  49.              (write-line  " PASS" testf)
  50.              (write-line  " FAIL" testf))
  51.          (write-line "    " testf)
  52.          ))
  53. )
  54.  
  55. (defun slowpick  ()
  56. ; returns "l" after awhile
  57.        (repeat 800 (setq x "l"))
  58. )
  59. (defun userpick ()
  60.        (terpri)
  61.        (command "erase") (getstring t "Move the pick box, hit RETURN")
  62.        (command)  
  63. )
  64. (defun dssetup ()
  65.        (setvar "cmdecho" 1)
  66.        (textscr) 
  67.        ; run dscfg to update ascii.cfg file for status, prompt, menu config
  68.        (command "shell" "dscfg")
  69.        (setvar "cmdecho" 0)
  70.        (setvar "blipmode" 0)
  71.        (setq cfgf (open "ascii.cfg" "r"))
  72.        (setq disp (read-line cfgf))
  73.        (setq cfg (read-line cfgf))
  74.        (setq sfgf (close cfgf))
  75.        (setq status (substr cfg 1 1))
  76.        (setq comnd (substr cfg 3 1))
  77.        (setq menu (substr cfg 5 1))
  78.        (terpri)
  79.        (print disp)    
  80.        (print "                             ")
  81.        (print (strcat "Status line    " status))
  82.        (print (strcat "Command prompt " comnd))
  83.        (print (strcat "Menu area      " menu))
  84.        (print "                             ")
  85.        (setq x 0)
  86.        (setq disp8 "")
  87.        (repeat 8 (if (= " " (substr disp (setq x (1+ x)) 1))
  88.                      (setq disp8 (strcat disp8 "-"))
  89.                      (setq disp8 (strcat disp8 (substr disp x 1))))
  90.        )
  91.        (setq disp8 (strcase disp8 T))
  92. )
  93. (defun getver ()
  94.        (setq midf (open "acad4.mid" "r"))
  95.        (if (null midf) (setq ver "")
  96.        (progn
  97.        (setq x "  ")
  98.          (while (and (/= "VERSION" x) (/= nil x))
  99.                (setq x (strcase (substr (setq ver (read-line midf)) 1 7)))
  100.          )
  101.        ))
  102. )
  103. (defun startestout (testfn)
  104.         (if (/= nil testf)
  105.             (setq testf (close testf)))
  106.  
  107.         (setq testf (open testfn "w"))
  108.  
  109.         (write-line disp testf)
  110.         (getver)
  111.         (if (/= "" ver)
  112.             (write-line ver testf))
  113.         (write-line "      " testf)
  114.         (write-line (strcat "Status line " status) testf)
  115.         (write-line (strcat "Command prompt " comnd) testf)
  116.         (write-line (strcat "Menu area " menu) testf)
  117.         (write-line "      " testf)
  118.         (write-line (rtos (getvar "cdate") 2) testf)
  119.         (write-line "      " testf)
  120.  
  121.         (print (strcat "Output test result file: " testfn))
  122. )
  123.  
  124. (defun C:SINGLE () 
  125.        (load "single")
  126. )
  127. (defun C:DUAL ()
  128.        (load "dual")
  129. )
  130. (defun C:COLORS ()
  131.        (load "colors") 
  132. )
  133. (defun C:NCFG ()
  134. ; figure out current yyy cfg and change it to the next
  135.        (setq cfglist (list
  136.                      '(yyy "Y Y N")
  137.                      '(yyn "Y N Y")
  138.                      '(yny "Y N N")
  139.                      '(ynn "N Y Y")
  140.                      '(nyy "N Y N")
  141.                      '(nyn "N N Y")
  142.                      '(nny "N N N")
  143.                      '(nnn "Y Y Y")
  144.                           ))
  145.        (if (or (null status) (null comnd) (null menu))
  146.            (dssetup) 
  147.            (progn
  148.             (textscr)
  149.             (terpri)
  150.             (print (strcat "Current status, command, menu: " status " " comnd " " menu))
  151.             (wait 2000)
  152.            ))
  153.        (setq x (read (strcat status comnd menu)))
  154.        (setq nxtcfg (assoc x cfglist))
  155.        (setq nxtcfg (car (cdr nxtcfg)))
  156.        (print (strcat "Change status, command, menu to " nxtcfg))
  157.        (command "shell" (strcat "dscfg " nxtcfg))
  158.        (command "script" "outin")
  159. )
  160.  
  161.